home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / VGADOC4B.ZIP / SHOWTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1995-09-29  |  19KB  |  727 lines
  1. uses dos;
  2.  
  3. {$i VGADECL.INC}
  4. type
  5.  
  6.   rs=record    {Result data for each mode}
  7.        tst:_AT2;
  8.        com2:string;
  9.        r:array[3..6] of
  10.           record
  11.             a:_AT3;
  12.             com:string;
  13.           end;
  14.        wd:word;
  15.        rg:array[1..1] of byte;   {Dummy array, actual size depends on allocation}
  16.      end;
  17.  
  18.   prs=^rs;
  19.  
  20. var
  21.   buf:array[0..2048] of byte;
  22.   f:file;
  23.   t:text;
  24.   fofs:longint;
  25.   fst,fbytes:word;
  26.   eoff:boolean;
  27.  
  28.   ModeNam:string;
  29.   clknames:word;
  30.   clknam:array[1..20] of string[20];
  31.  
  32.   AT0:record
  33.         r:_AT0;
  34.         email,nam,vid,sys,mods:string;
  35.       end;
  36.   AT1:array[1..10] of vidinfo;
  37.  
  38.   res:array[1..100] of prs;
  39.   ress,vds:word;
  40.  
  41.   mtxt:array[1..max_mode] of string[4];
  42.  
  43. function featt(feat:word):string;
  44. var s:string[4];
  45. begin
  46.   s:='    ';
  47.   if (feat and ft_cursor)>0 then s[1]:='C';
  48.   if (feat and ft_blit)>0 then s[2]:='B';
  49.   if (feat and ft_line)>0 then s[3]:='L';
  50.   if (feat and ft_rwbank)>0 then s[4]:='R';
  51.   featt:=s;
  52. end;
  53.  
  54. function hex2(w:word):string;
  55. const hx:array[0..15] of char='0123456789ABCDEF';
  56. begin
  57.   hex2:=hx[lo(w) shr 4]+hx[w and 15];
  58. end;
  59.  
  60. function hex4(w:word):string;
  61. const hx:array[0..15] of char='0123456789ABCDEF';
  62. begin
  63.   hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[lo(w) shr 4]+hx[w and 15];
  64. end;
  65.  
  66. procedure fillbuf;
  67. var x:word;
  68. begin
  69.   if  (fst>0) and not eoff then
  70.   begin
  71.     dec(fbytes,fst);
  72.     move(buf[fst],buf,fbytes);
  73.     inc(fofs,fst);
  74.   end;
  75.   fst:=0;
  76.   if (fbytes<1500) and not eoff then
  77.   begin
  78.     blockread(f,buf[fbytes],2000-fbytes,x);
  79.     inc(fbytes,x);
  80.   end;
  81. end;
  82.  
  83. procedure cp(var b;byt:word);
  84. begin
  85.   move(buf[fst],b,byt);
  86.   inc(fst,byt);
  87. end;
  88.  
  89. procedure rdstr(var s:string);
  90. begin
  91.   cp(s,buf[fst]+1);
  92. end;
  93.  
  94. procedure rdat0(var a:_AT0;var nam,vid,sys:string);
  95. var x:word;
  96. begin
  97.   move(buf[fst+1],x,2);
  98.   inc(x,fst);
  99.   inc(fst,3);
  100.   cp(a,sizeof(_AT0));
  101.   rdstr(nam);
  102.   rdstr(vid);
  103.   rdstr(sys);
  104.   rdstr(ModeNam);
  105.   clknames:=0;
  106.   repeat            {Read the Clock type list}
  107.     inc(clknames);
  108.     rdstr(clknam[clknames]);
  109.   until clknam[clknames]='';
  110.  
  111.   fst:=x;
  112.   fillbuf;
  113. end;
  114.  
  115. function opentstfil(nam:string):boolean;
  116. var
  117.   x,y,z:word;
  118.   a2:_AT2;
  119.   a3:_AT3;
  120.   c2,s:string;
  121.   mm:byte;
  122. begin
  123.   opentstfil:=true;
  124.   eoff:=false;
  125.   if pos('.',nam)=0 then nam:=nam+'.tst';
  126.   assign(f,nam);
  127.   {$i-}
  128.   reset(f,1);
  129.   {$i+}
  130.   if ioresult<>0 then opentstfil:=false
  131.   else begin
  132.     fbytes:=0;fst:=0;fofs:=0;
  133.     fillbuf;
  134.   {  rdAT0(at0.r,at0.nam,at0.vid,at0.sys);
  135.     for x:=1 to at0.r.vid_sys do
  136.     begin
  137.       move(buf[fst+1],y,2);
  138.       move(buf[fst+3],at1[x],sizeof(_at1));
  139.       inc(fst,y);
  140.       fillbuf;
  141.     end; }
  142.     ress:=0;
  143.     vds:=0;
  144.     while (fbytes>0) and not eoff do
  145.     begin
  146.       x:=fst;
  147.       move(buf[fst+1],z,2);
  148.       inc(z,fst);
  149.       inc(fst,3);
  150.       case buf[x] of
  151.         0:begin
  152.             cp(at0.r,sizeof(_AT0));
  153.             rdstr(at0.email);
  154.             rdstr(at0.nam);
  155.             rdstr(at0.vid);
  156.             rdstr(at0.sys);
  157.             rdstr(at0.mods);
  158.             s:=at0.mods;
  159.             if s='' then s:='TXT TXT2TXT4HERCCGA1CGA2PL1 PL1EPL2 PK2 PL4 PK4 P8  P15 P16 P24 P32 ';
  160.             mm:=_text;
  161.             while s<>'' do
  162.             begin
  163.               mtxt[mm]:=copy(s,1,4);
  164.               delete(s,1,4);
  165.               inc(mm);
  166.             end;
  167.             clknames:=0;
  168.             repeat            {Read the Clock type list}
  169.               inc(clknames);
  170.               rdstr(clknam[clknames]);
  171.             until clknam[clknames]='';
  172.           end;
  173.         1:begin
  174.             inc(vds);
  175.             cp(at1[vds],sizeof(vidinfo));
  176.           end;
  177.         2:begin
  178.             cp(a2,sizeof(_AT2));
  179.             rdstr(c2);
  180.             y:=z-fst;
  181.             inc(ress);
  182.             getmem(res[ress],sizeof(rs)+y);
  183.             fillchar(res[ress]^,sizeof(rs),0);
  184.             res[ress]^.wd:=sizeof(rs)+y;
  185.             move(a2,res[ress]^.tst,sizeof(a2));
  186.             res[ress]^.com2:=c2;
  187.             move(buf[fst],res[ress]^.rg,y);
  188.           end;
  189.      3..6:begin
  190.             cp(a3,sizeof(_AT3));
  191.             rdstr(c2);
  192.             for y:=1 to ress do
  193.               if (res[y]^.tst.mode=a3.mode) and
  194.                 (res[y]^.tst.Mmode=a3.Mmode) then
  195.               begin
  196.                 move(a3,res[y]^.r[buf[x]].a,sizeof(a3));
  197.                 res[y]^.r[buf[x]].com:=c2;
  198.               end;
  199.  
  200.           end;
  201.       255:begin
  202.             eoff:=true;
  203.           end;
  204.       end;
  205.       fst:=z;
  206.       fillbuf;
  207.     end;
  208.   end;
  209. end;
  210.  
  211. procedure closetst;
  212. var x:word;
  213. begin
  214.   close(f);
  215.   for x:=1 to ress do
  216.     freemem(res[x],res[x]^.wd);
  217. end;
  218.  
  219. procedure wrdata(fnam:string);
  220. begin
  221.   if opentstfil(fnam) then
  222.   begin
  223.     closetst;
  224.   end;
  225. end;
  226.  
  227. procedure wrsumm;
  228. var
  229.   DI:searchrec;
  230.   p:^vidinfo;
  231. begin
  232.   writeln('     File:     Chip:  Vers: Mem: Feat:      Dac:            Name:');
  233.        {     WHVGA123.tst aabbccdd 5678  2048 C  R Sierra SC15025______ }
  234.   findfirst('*.tst',0,DI);
  235.   while doserror=0 do
  236.   begin
  237.     if opentstfil(DI.name) then
  238.     begin
  239.       p:=@AT1[AT0.r.cur_vid];
  240.  
  241.       writeln(DI.name:12,copy(' '+chipnam[p^.chip]+'         ',1,10)
  242.              +hex4(p^.subvers),p^.mm:6,' '+featt(p^.features)+' '+copy(p^.dacname
  243.              +'                     ',1,21)+p^.name);
  244.       closetst;
  245.     end;
  246.     findnext(DI);
  247.   end;
  248. end;
  249.  
  250. function d2(w:word):string;
  251. begin
  252.   w:=w mod 100;
  253.   d2:=chr(w div 10+48)+chr(w mod 10+48);
  254. end;
  255.  
  256. function SWvers(swver:word):string;
  257. var s:string;
  258. begin
  259.   str(swver div 1000,s);
  260.   s:=s+'.'+d2(swver div 10);
  261.   if (SWver mod 10)>0 then s:=s+chr(SWver mod 10+$60);
  262.   SWvers:=s;
  263. end;
  264.  
  265. function Wdate(dt:longint):string;
  266. const
  267.   mon:array[1..12] of string[3]=('jan','feb','mar','apr','may','jun'
  268.                                 ,'jul','aug','sep','oct','nov','dec');
  269. var d:datetime;
  270. begin
  271.   unpacktime(dt,d);
  272.   Wdate:=d2(d.hour)+':'+d2(d.min)+':'+d2(d.sec)+' '
  273.         +d2(d.day)+'/'+mon[d.month]+'/'+d2(d.year div 100)+d2(d.year);
  274. end;
  275.  
  276. function Clk(r:real):string;
  277. var s:string;
  278. begin
  279.   if r<0.1 then Clk:='        '
  280.   else begin
  281.     str(r:8:3,s);
  282.     Clk:=s;
  283.   end;
  284. end;
  285.  
  286. function freq(frq:longint):string;
  287. var w:word;
  288.   st:string[5];
  289. begin
  290.   w:=frq mod 1000;
  291.   str(frq div 1000:3,st);
  292.   freq:=st+'.'+chr((w div 100)+48)+chr(((w div 10) mod 10)+48)+chr((w mod 10)+48);
  293. end;
  294.  
  295. procedure wrdetail(nam,tnam:string);
  296. const
  297.  ni:array[boolean] of string[2]=('  ',' i');
  298.  tok1:array[0..1] of string[4]=(' No ',' Ok ');
  299.  tok2:array[0..3] of string[4]=('    ',' No ',' Ok ',' Ok ');
  300. var
  301.   x,y:word;
  302.   sok:string;
  303.   t:text;
  304.   p:^vidinfo;
  305. begin
  306.   if opentstfil(nam) then
  307.   begin
  308.     x:=pos('.',nam);
  309.     if x>0 then nam[0]:=chr(x-1);
  310.     assign(t,nam+'.txt');
  311.     rewrite(t);
  312.     writeln(t,'File: '+nam+' Whatvga version: '+SWvers(at0.r.SWvers)
  313.               +' Date: '+Wdate(at0.r.curtime));
  314.     writeln(t,'Tester:');
  315.     writeln(t,at0.email);
  316.     writeln(t);
  317.     writeln(t,at0.nam);
  318.     writeln(t);
  319.     writeln(t,'Video System:');
  320.     writeln(t,at0.vid);
  321.     writeln(t);
  322.     writeln(t,'System description:');
  323.     writeln(t,at0.sys);
  324.     writeln(t);
  325.  
  326.     if at0.r.vid_sys>1 then
  327.     begin
  328.       writeln(t,'Video systems:');
  329.       for x:=1 to at0.r.vid_sys do
  330.       begin
  331.         p:=@AT1[x];
  332.         writeln(t,copy(' '+chipnam[p^.chip]+'         ',1,10)
  333.                +hex4(p^.subvers),p^.mm:6,' '+featt(p^.features)+' '+copy(p^.dacname
  334.                +'                     ',1,21)+p^.name);
  335.       end;
  336.       writeln(t);
  337.     end;
  338.  
  339.     writeln(t,'Active Video System:');
  340.     p:=@AT1[AT0.r.cur_vid];
  341.  
  342.     writeln(t,chipnam[p^.chip]+' Revision: '+hex4(p^.subvers)
  343.            +' '+p^.name+' with ',p^.mm,' Kbytes');
  344.     writeln(t,'Instance: '+hex4(p^.id)+' IOadr: '+hex4(p^.IOadr)
  345.            +' XGAseg: '+hex4(p^.xseg)+' Padr: '+hex4(p^.Phadr shr 16)+hex4(p^.phadr));
  346.     if p^.features<>0 then
  347.     begin
  348.       write(t,'Features:');
  349.       if (p^.features and ft_cursor)>0 then write(t,' Cursor');
  350.       if (p^.features and ft_blit)>0 then write(t,' BitBLT');
  351.       if (p^.features and ft_line)>0 then write(t,' Line');
  352.       if (p^.features and ft_rwbank)>0 then write(t,' RW-bank');
  353.       writeln(t);
  354.     end;
  355.     writeln(t,'DAC: '+p^.dacname);
  356.     writeln(t,'CLK: '+ClkNam[p^.clktype]);
  357.  
  358.     writeln(t);
  359.     writeln(t,'  Mode:     X    Y  Byte Drw Scr Ana Cur Blt Lin RW:   Vclk    Hclk    Fclk  i');
  360.           {    0038 P8__ 1024  768 1024 Ok  Ok  Ok  Ok  Ok  Ok  Ok}
  361.     for x:=1 to ress do
  362.       with res[x]^ do
  363.       begin
  364.         if (tst.pixels<>tst.Cpixels) or (tst.lins<>tst.Clins)
  365.          or (tst.bytes<>tst.Cbytes) or (tst.MMode<>tst.CMmode) then
  366.            tst.flag:=tst.flag and 31
  367.         else tst.flag:=tst.flag or 128;
  368.         write(t,hex4(tst.mode)+' '+mtxt[tst.mmode],tst.pixels:5,tst.Lins:5,tst.Bytes:5);
  369.         sok:='                            ';
  370.         if (tst.flag and 1)>0 then
  371.         begin
  372.           sok:=tok1[(tst.flag and AFF_dispok) shr 1]
  373.               +tok2[(tst.flag and (AFF_scroll+AFF_scrollok)) shr 2]
  374.               +tok1[(tst.flag shr 7)];
  375.           for y:=3 to 6 do
  376.             if (tst.mode=r[y].a.mode) then sok:=sok+tok1[r[y].a.flag and AFF_testok]
  377.             else sok:=sok+'    ';
  378.  
  379.           writeln(t,sok+' '+freq(tst.vclk)+' '+freq(tst.Hclk)+' '+freq(tst.Fclk)+ni[tst.ilace]);
  380.           if (tst.flag and AFF_canceled)>0 then writeln(t,'   Mode was disabled by the user!!!!!');
  381.           if (com2<>'') then writeln(t,'    Comment:  '+com2);
  382.           if (tst.flag and 128)=0 then
  383.             writeln(t,'    Analysis: Real: ',tst.pixels,'x',tst.lins
  384.                    ,' '+mtxt[tst.mmode]+' (',tst.bytes,' bytes) Calc: '
  385.                    ,tst.Cpixels,'x',tst.Clins,' '+mtxt[tst.Cmmode]+' ('
  386.                    ,tst.Cbytes,' bytes)');
  387.           if (r[3].com<>'') then writeln(t,'    Cursor:   '+r[3].com);
  388.           if (r[4].com<>'') then writeln(t,'    BitBlt:   '+r[4].com);
  389.           if (r[5].com<>'') then writeln(t,'    Linedraw: '+r[5].com);
  390.           if (r[6].com<>'') then writeln(t,'    R/W bank: '+r[6].com);
  391.         end
  392.         else writeln(t,' - Mode did not set');
  393.  
  394.       end;
  395.     close(t);
  396.     closetst;
  397.   end;
  398. end;
  399.  
  400. procedure wrregs(nam,tnam:string;grfonly:boolean);
  401. type
  402.   iarr=array[1..1000] of integer;
  403.   barr=array[1..1000] of byte;
  404.   iarrp=^iarr;
  405. var p:^vidinfo;
  406.   x,y,z,u,v,w,rgs:word;
  407.   i:integer;
  408.   stop:boolean;
  409.   rgg:array[1..1000] of
  410.       record
  411.         ofs:word;
  412.         inx,
  413.         typ:byte;   {1: special, 2: reg, 3: index}
  414.       end;
  415.   vll:array[1..100] of iarrp;
  416.   bp:^barr;
  417.   bpo:word;
  418.   wp:iarrp;
  419.   s:string;
  420.  
  421. const
  422.   spcreg:array[1..2] of string[8]=('Old seqD','Old seqE');
  423.  
  424. function popb:word;
  425. begin
  426.   inc(bpo);
  427.   popb:=bp^[bpo];
  428. end;
  429.  
  430. function popw:word;
  431. var w:word;
  432. begin
  433.   w:=popb;
  434.   popw:=w+(popb shl 8);
  435. end;
  436.  
  437. procedure addval(base,ix,typ,val:word);
  438. var x:word;
  439. begin
  440.   if (base and $FFF0)=$3B0 then inc(base,$20);  {3Bx -> 3Dx}
  441.   for x:=1 to rgs do
  442.     if (rgg[x].ofs=base) and (rgg[x].typ=typ) and (rgg[x].inx=ix) then
  443.       wp^[x]:=val;
  444. end;
  445.  
  446. procedure addrg(base,ix,typ:word);
  447. var x,y:word;
  448. begin
  449.   if (base and $FFF0)=$3B0 then inc(base,$20);  {3Bx -> 3Dx}
  450.   x:=1;y:=rgs+1;
  451.   while x<=rgs do
  452.     if (base>rgg[x].ofs) or ((base=rgg[x].ofs) and
  453.         ((typ>rgg[x].typ) or ((typ=rgg[x].typ) and
  454.         (ix>rgg[x].inx)))) then inc(x)
  455.     else begin
  456.       y:=x;
  457.       x:=maxint;
  458.     end;
  459.  
  460.   if (base<>rgg[y].ofs) or (typ<>rgg[y].typ) or (ix<>rgg[y].inx) then
  461.   begin
  462.    { for x:=rgs downto y do rgg[x+1]:=rgg[x]; }
  463.  
  464.     if rgs>=y then
  465.       move(rgg[y],rgg[y+1],(rgs-y+1)*sizeof(rgg[1]));
  466.     rgg[y].ofs :=base;
  467.     rgg[y].typ :=typ;
  468.     rgg[y].inx :=ix;
  469.     inc(rgs);
  470.   end;
  471.  
  472. end;
  473.  
  474. var
  475.   _rs:array[1..100] of prs;
  476.   _rss:word;
  477.  
  478. begin
  479.  
  480.   rgs:=0;
  481.   if opentstfil(nam) then
  482.   begin
  483.     _rss:=0;
  484.     for x:=1 to ress do
  485.       if ((not grfonly) or (res[x]^.tst.mmode>_pl1))
  486.        and ((res[x]^.tst.flag and 1)>0) then
  487.       begin
  488.         inc(_rss);
  489.         _rs[_rss]:=res[x];
  490.       end;
  491.  
  492.     x:=pos('.',nam);
  493.     if x>0 then nam[0]:=chr(x-1);
  494.     assign(t,nam+'.reg');
  495.     rewrite(t);
  496.     writeln(t,'File: '+nam+' Whatvga version: '+SWvers(at0.r.SWvers)
  497.               +' Date: '+Wdate(at0.r.curtime));
  498.     p:=@AT1[AT0.r.cur_vid];
  499.  
  500.     writeln(t,chipnam[p^.chip]+' Revision: '+hex4(p^.subvers)
  501.            +' '+p^.name+' with ',p^.mm,' Kbytes');
  502.     writeln(t);
  503.  
  504.     write(t,'Mode:    ');
  505.     for x:=1 to _rss do write(t,' '+hex4(_rs[x]^.tst.mode));
  506.     writeln(t);
  507.     write(t,'Pixels:  ');
  508.     for x:=1 to _rss do write(t,_rs[x]^.tst.pixels:5);
  509.     writeln(t);
  510.     write(t,' - Calc: ');
  511.     for x:=1 to _rss do write(t,_rs[x]^.tst.Cpixels:5);
  512.     writeln(t);
  513.     write(t,'Lines:   ');
  514.     for x:=1 to _rss do write(t,_rs[x]^.tst.lins:5);
  515.     writeln(t);
  516.     write(t,' - Calc: ');
  517.     for x:=1 to _rss do write(t,_rs[x]^.tst.Clins:5);
  518.     writeln(t);
  519.     write(t,'Bytes:   ');
  520.     for x:=1 to _rss do write(t,_rs[x]^.tst.bytes:5);
  521.     writeln(t);
  522.     write(t,' - Calc: ');
  523.     for x:=1 to _rss do write(t,_rs[x]^.tst.Cbytes:5);
  524.     writeln(t);
  525.     write(t,'MemMode: ');
  526.     for x:=1 to _rss do write(t,' '+mtxt[_rs[x]^.tst.Mmode]);
  527.     writeln(t);
  528.     write(t,' - Calc: ');
  529.     for x:=1 to _rss do write(t,' '+mtxt[_rs[x]^.tst.CMmode]);
  530.     writeln(t);
  531.  
  532.     for x:=1 to _rss do
  533.     begin
  534.       bp:=@_rs[x]^.rg;bpo:=0;stop:=false;
  535.       repeat
  536.         z:=popw;
  537.         case z of
  538.           0:stop:=true;
  539.           1:begin
  540.               w:=popw;
  541.               u:=popb;v:=popb;
  542.               for z:=u to v do addrg(w,z,3);
  543.               inc(bpo,v-u+1);
  544.             end;
  545.         255:begin
  546.               addrg(popw,0,1);
  547.               inc(bpo);
  548.             end;
  549.         else
  550.           if z<256 then
  551.           begin
  552.             w:=popw;
  553.             for w:=w to w+z-1 do addrg(w,0,2);
  554.             inc(bpo,z);
  555.           end
  556.           else begin
  557.             addrg(z,0,2);
  558.             inc(bpo);
  559.           end;
  560.         end;
  561.       until stop;
  562.     end;
  563.     for x:=1 to _rss do
  564.     begin
  565.       getmem(wp,rgs*2);
  566.       for y:=1 to rgs do wp^[y]:=-1;
  567.       bp:=@_rs[x]^.rg;bpo:=0;stop:=false;
  568.       repeat
  569.         z:=popw;
  570.         case z of
  571.           0:stop:=true;
  572.           1:begin
  573.               w:=popw;
  574.               u:=popb;v:=popb;
  575.               for z:=u to v do addval(w,z,3,popb);
  576.             end;
  577.         255:begin
  578.               w:=popw;
  579.               addval(w,0,1,popb);
  580.             end;
  581.         else
  582.           if z<256 then
  583.           begin
  584.             w:=popw;
  585.             for w:=w to w+z-1 do addval(w,0,2,popb);
  586.           end
  587.           else addval(z,0,2,popb);
  588.         end;
  589.       until stop;
  590.       vll[x]:=wp;
  591.     end;
  592.     for x:=1 to rgs do
  593.     begin
  594.       case rgg[x].typ of
  595.         1:if rgg[x].ofs<$F000 then s:=spcreg[rgg[x].ofs+1]
  596.           else s:='DAC '+hex2(rgg[x].ofs)+'  ';
  597.         2:s:=hex4(rgg[x].ofs)+'    ';
  598.         3:s:=hex4(rgg[x].ofs)+' i'+hex2(rgg[x].inx);
  599.       end;
  600.       write(t,s+':');
  601.       w:=vll[1]^[x];
  602.       stop:=(w>=0);
  603.       for y:=1 to _rss do
  604.         if (w<>vll[y]^[x]) and (vll[y]^[x]>=0) then stop:=false;
  605.       if stop then
  606.       begin
  607.         write(t,'   '+hex2(w));
  608.         for y:=2 to _rss do
  609.         begin
  610.           i:=vll[y]^[x];
  611.           if i<0 then write(t,'   --')
  612.           else if i=w then write(t,'    =')
  613.                       else write(t,'   '+hex2(i));
  614.         end;
  615.       end
  616.       else
  617.         for y:=1 to _rss do
  618.           if vll[y]^[x]<0 then write(t,'   --')
  619.                           else write(t,'   '+hex2(vll[y]^[x]));
  620.       writeln(t);
  621.  
  622.     end;
  623.  
  624.     closetst;
  625.     for x:=1 to _rss do freemem(vll[x],rgs*2);
  626.   end;
  627. end;
  628.  
  629. procedure wrBIOS(nam,tnam:string);
  630. var rhdr:_ATFF;
  631.   z,x,y:word;
  632.   l:longint;
  633.   o:file;
  634.   t:text;
  635.  
  636. begin
  637.   if opentstfil(nam) then
  638.   begin
  639.     x:=pos('.',nam);
  640.     if x>0 then nam[0]:=chr(x-1);
  641.     assign(o,nam+'.rom');
  642.     rewrite(o,1);
  643.     assign(t,nam+'.vct');
  644.     rewrite(t);
  645.     seek(f,fofs);
  646.     blockread(f,buf,512);
  647.     move(buf[1],z,2);
  648.     move(buf[3],rhdr,sizeof(rhdr));
  649.     writeln(t,'Int 10h:  '+hex4(rhdr.int10));
  650.     writeln(t,'Int 6Dh:  '+hex4(rhdr.int6d));
  651.     writeln(t,'Save Vct: '+hex4(rhdr.m4a8));
  652.     writeln(t,'Fnt 8h:   '+hex4(rhdr.fnt8h));
  653.     writeln(t,'Fnt 8l:   '+hex4(rhdr.fnt8l));
  654.     writeln(t,'Fnt 14:   '+hex4(rhdr.fnt14));
  655.     writeln(t,'Fnt 14x9: '+hex4(rhdr.fnt14x9));
  656.     writeln(t,'Fnt 16:   '+hex4(rhdr.fnt16));
  657.     writeln(t,'Fnt 16x9: '+hex4(rhdr.fnt16x9));
  658.     close(t);
  659.     seek(f,fofs+z);
  660.     l:=rhdr.size*longint(512);
  661.     z:=0;
  662.     while l>0 do
  663.     begin
  664.       x:=2048;
  665.       if x>l then x:=l;
  666.       blockread(f,buf,x,y);
  667.       for y:=0 to x-1 do
  668.       begin
  669.         z:=lo(z+buf[y]);
  670.         buf[y]:=z;
  671.       end;
  672.       blockwrite(o,buf,x);
  673.       dec(l,x);
  674.     end;
  675.     closetst;
  676.     close(o);
  677.   end;
  678. end;
  679.  
  680. var
  681.   fill:array[1..10] of string;
  682.   fills,x:word;
  683.   s:string;
  684. const
  685.   bdump:boolean=false;
  686.   regs:boolean=false;
  687.   grfonly:boolean=false;
  688.   listfil:boolean=false;
  689.  
  690. begin
  691.  { if then directvideo:=false;}
  692.   fills:=0;fillchar(fill,sizeof(fill),0);
  693.   for x:=1 to paramcount do
  694.   begin
  695.     s:=paramstr(x);
  696.     if (s[1]='/') or (s[1]='-') then
  697.       case s[2] of
  698.         'b','B':bdump:=true;
  699.         'g','G':grfonly:=true;
  700.         'r','R':regs:=true;
  701.         'l','L':listfil:=true;
  702.  
  703.     '?','h','H':begin
  704.                   writeln('SHOWTEST analyses WHATVGA test files (WHVGA*.TST).');
  705.                   writeln('SHOWTEST /? or /h      displays this message');
  706.                   writeln('SHOWTEST /b file1 [file2]       Decodes the BIOS dump in testfile FILE1 to');
  707.                   writeln('                                FILE2 (default FILE1.rom & FILE1.vec)');
  708.                   writeln('SHOWTEST /r [/g] file1 [file2]  Writes a register dump of the modes in testfile');
  709.                   writeln('                                FILE1 to FILE2 (default FILE1.reg). If /g is');
  710.                   writeln('                                used only graphics modes are dumped.');
  711.                   writeln('SHOWTEST file1 [file2]          Writes a detailed test report of the testfile');
  712.                   writeln('                                FILE1 to FILE2 (default FILE1.txt)');
  713.                   writeln('SHOWTEST /l                     Lists the testfiles (*.TST)');
  714.                   halt;
  715.                 end;
  716.       end
  717.     else begin
  718.       inc(fills);
  719.       fill[fills]:=s;
  720.     end;
  721.   end;
  722.   if listfil or (fills=0) then wrsumm
  723.   else if bdump then wrBIOS(fill[1],fill[2])
  724.        else if regs then wrregs(fill[1],fill[2],grfonly)
  725.             else wrdetail(fill[1],fill[2]);
  726. end.
  727.